package Chatter;

use base Class::Accessor;
use strict;
use warnings;
use Carp::Clan;
use Data::Dumper;
use WWW::Mechanize;
use Web::Scraper;
use Mail::Address;
use Date::Simple;
use URI;

my $LOGON_URL = 'https://login.salesforce.com/';
my $USERLIST_URL = '/_ui/common/search/client/ui/UnifiedSearchResults?searchType=2';
my $USERPROFILE_URL = '/_ui/core/userprofile/UserProfilePage?u=';
my $WAIT = 1;

# コンストラクタ
sub new {
  my ($class,$uid,$pwd) = @_;
  croak("Logon parameters are missing.") if($uid eq "" || $pwd eq "");

  # 検索キーとなるドメイン抽出
  my $mailaddr = Mail::Address->new("user", $uid);
  my $domain = $mailaddr->host;

  my $self = bless {
    mech      => WWW::Mechanize->new(),
    uid       => $uid,
    pwd       => $pwd,
    searchkey => $domain,
    hostname  => undef,
    response => undef,
  }, $class;

  $self->mech->agent_alias('Windows Mozilla');
  return $self;
}
__PACKAGE__->mk_accessors(qw/mech uid pwd searchkey hostname response/);

# ログオン
sub logon {
  my ($self) = @_;

  # ログオンフォーム
  my $res = $self->mech->get($LOGON_URL);
  $self->mech->form_number(1);
  $self->mech->set_fields(
    un             => $self->uid,
    username       => $self->uid,
    pw             => $self->pwd,
    width          => 1600,
    height         => 1200,
    hasRememberUn  => 'true',
    startURL       => '',
    loginURL       => '',
    loginType      => 'u',
    useSecure      => 'true',
    local          => '',
    lt             => 'standard',
    qs             => '',
    locale         => 'jp',
    oauth_token    => '',
    oauth_callback => '',
    Login          => 'ログイン',
  );

  # ログオン
  $res = $self->mech->submit;
  croak("Abend at Mechanize.") unless($res->is_success);
  $self->response($res);

  # 遷移先抽出
  my $content = $self->_enc($self->mech->content);
  my $location = $self->_parseLocation($content);
  if($location){
    $self->hostname($location);
  } else {
    croak("Logon error. Could not find next location.");
  }
  return $content;
}

# ユーザ一覧取得
sub getUserList {
  my ($self, $recurseflag, $offset) = @_;
  $recurseflag = 0 unless($recurseflag);
  $offset = 0 unless($offset);

  # ユーザ一覧ページ取得
  my $url = $self->hostname.$USERLIST_URL."&str=".$self->searchkey."&offset=$offset";
  my $content = $self->getContent($url);

  # ユーザ抽出
  my $list = $self->parseUser($content);

  # 再帰
  if($list && $recurseflag && scalar(@$list)==25){
    my $recsList = $self->getUserList($recurseflag, $offset + 25);
    push(@$list, @$recsList);
  }
  return $list;
}

# ユーザ抽出
sub parseUser {
  my ($self, $content) = @_;
  croak("Invalid content.") unless($content);

  my $scraper = scraper {
    process 'div.displayName > a', 'list[]' => {
      name => 'TEXT',
      accountId => [ '@href', sub { s/\/(.*)\?.*/$1/ } ],
    }
  };
  my $list = $scraper->scrape($content)->{list};
  return $list;
}

# スレッド一覧取得
sub getThreadList {
  my ($self, $user) = @_;
  croak("Missing user parameter.") unless($user);

  my $id = $user->{accountId};
  my $name = $user->{name};

  # コンテンツ取得
  my $url = $USERPROFILE_URL.$id;
  my $content = $self->getContent($url);
  croak("Invalid content.") unless($content);

  # スレッド抽出
  my $list = {
    name => $name,
    accountId => $id,
    url => $url,
    thread => $self->_parseThread($content),
  };

  # プロファイル抽出
  my $profile = $self->_parseProfile($content);
  $list = { %$list, %$profile };

  return $list;
}

# リプライ一覧取得
sub getReplyList {
  my ($self, $thread) = @_;
  croak("Missing thread parameter.") unless($thread);

  #スレッドをループ
  my @tweetlist;
  my $threadlist = $thread->{thread};
  if($threadlist){
    for(my $i=0; $i < scalar(@$threadlist); $i++){

      # コンテンツ取得
      my $url = $threadlist->[$i]->{url};
      my $content = $self->getContent($url);
      croak("Invalid content.") unless($content);

      # リプライ抽出
      $threadlist->[$i]->{replies} = $self->_parseReply($content);
    }
  }
  return $thread;
}

# --- private methods ----------------------

# スレッド抽出
sub _parseThread {
  my ($self, $content) = @_;
  croak("Invalid content.") unless($content);

  my $scraper = scraper {
    process 'div.feeditemcontent', 'list[]' => scraper {
      # ユーザ情報
      process 'div > a.actorentitylink',
        accountId => [ '@href', sub { s/\/// } ],
        name => 'TEXT';
      # ユーザ情報（グループ投稿時）
      process 'div > span.feeditemsecondentity > a.actorentitylink',
        accountId => [ '@href', sub { s/\/// } ],
        name => 'TEXT';
      # グループ情報
      process 'div > a.feeditemfirstentity',
        groupId => [ '@href', sub { s/\/// } ],
        groupName => 'TEXT';
      # ツイート
      process 'span.feeditemtext',
        tweet => [ 'HTML', sub { s/^\s+// } ],
      # 投稿時間
      process 'div.feeditemfooter > a.feeditemtimestamp',
        created => [ 'TEXT', sub { $self->_parseTimestamp($_) } ],
        url => '@href';
    };
  };
  my $list = $scraper->scrape($content)->{list};
  return $list;
}

# プロファイル抽出
sub _parseProfile {
  my ($self, $content) = @_;
  croak("Invalid content.") unless($content);

  my $scraper = scraper {
    process 'div.profileSectionData.emailAddr > a', 'email' => 'TEXT';
    process 'span[id="moreFollowersLink"]', 'followers' =>  [ 'TEXT', sub { s/すべて表示 \((.*)\)/$1/ } ];
    process 'span[id="showFollowingLink"]', 'followings' => [ 'TEXT', sub { s/すべて表示 \((.*)\)/$1/ } ];
  };
  my $scr = $scraper->scrape($content);
  my $profile = {
    email => $scr->{email},
    followers => $scr->{followers},
    followings => $scr->{followings},
  };
  return $profile;
}

# リプライ抽出
sub _parseReply {
  my ($self, $content) = @_;
  croak("Invalid content.") unless($content);

  my $scraper = scraper {
    process 'span.feeditemcommentbody', 'list[]' => scraper {
      # ユーザ情報
      process 'span.feedcommentuser > a',
        accountId => [ '@href', sub { s/\/// } ],
        name => 'TEXT';
      # 返信内容
      process 'span.feedcommenttext',
        tweet => 'HTML';
      # 投稿時刻
      process 'span.feedcommentfooter > span.feeditemtimestamp',
        created => [ 'TEXT', sub { $self->_parseTimestamp($_) } ];
      # 返信ID
      #process 'span.feedcommentfooter > a.feeditemactionlink',
      # replayId => [ '@onclick', sub { s/.*this, event, '(.*)'.*/$1/ } ];
    };
  };
  my $list = $scraper->scrape($content)->{list};
  return $list;
}

# --- utility methods ----------------------

# コンテンツ取得
sub getContent {
  my ($self, $url) = @_;
  croak("Missing url parameter.") unless($url);

  sleep($WAIT);
  my $res = $self->mech->get($url);
  croak("Abend at Mechanize.") unless($res->is_success);
  $self->response($res);

  my $content = $self->_enc($res->decoded_content(charset => 'utf8'));
  return $content;
}

# コンテンツエンコード
sub _enc {
  my ($self, $content) = @_;
  return undef unless($content);

  $content = Encode::encode_utf8($content) if(utf8::is_utf8($content));
  return $content;
}

# 遷移先Parse
sub _parseLocation {
  my ($self, $content) = @_;
  return undef unless($content);

  if($content =~ /var url = '(.*?)';/){
    my $url = URI->new($1);
    return $url->scheme.'://'.$url->host;
  }
  return undef;
}

# 日付文字列修正
sub _parseTimestamp {
  my ($self, $timestamp) = @_;
  return undef unless($timestamp);

  my $d = Date::Simple->new();
  $timestamp =~ s/\(/ /;
  $timestamp =~ s/\)//;

  if(index($timestamp, "今日") != -1){
    my $df = $d->format('%Y/%m/%d');
    $timestamp =~ s/今日/$df/;
    return $timestamp;
  } elsif(index($timestamp, "昨日") != -1){
    $d = $d->prev;
    my $df = $d->format('%Y/%m/%d');
    $timestamp =~ s/昨日/$df/;
    return $timestamp;
  } elsif(index($timestamp, "日前") != -1){
    $d = $d - $1 if($timestamp =~ /(\d) 日前/);
    my $df = $d->format('%Y/%m/%d');
    $timestamp =~ s/.*日前/$df/;
    return $timestamp;
  }
  return $timestamp;
}

1;

